home *** CD-ROM | disk | FTP | other *** search
/ Best of www.BestZips.com (Collector's Edition) / Best of WWW.BESTZIPS.COM Collector's Edition (JCSM Shareware) (JCS Marketing).ISO / tutorial / adatu311.zip / ADA_TUTR.ADA < prev    next >
Text File  |  1996-01-10  |  27KB  |  531 lines

  1. -- ADA_TUTR.ADA   Ver. 3.11   10-JAN-1996   Copyright 1988-1996 John J. Herro
  2. --
  3. -- SOFTWARE INNOVATIONS TECHNOLOGY          http://members.aol.com/AdaTutor
  4. -- 1083 MANDARIN DR NE                      ftp://members.aol.com/AdaTutor
  5. -- PALM BAY FL 32905-4706
  6. --                                          johnherro@aol.com
  7. -- (407) 951-0233                           john.herro%374-38-2@satlink.oau.org
  8. --
  9. -- Before compiling this file, you must compile ONE of the following:
  10. --
  11. --    JANUS16.PKG   Recommended when using a PC with 16-bit Janus/Ada.
  12. --    JANUS32.PKG   Recommended when using a PC with 32-bit Janus/Ada.
  13. --    OPEN.ADA      Recommended when using a PC with an Open Ada compiler.
  14. --    UNIX.ADA      Recommended for UNIX based systems, if you can also
  15. --                     compile ONECHAR.C or ALTCHAR.C with a C compiler and
  16. --                     link with Ada.
  17. --    VAX.ADA       Recommended when using VAX Ada.
  18. --    VANILLA.ADA   "Plain vanilla" version for all other systems.  Should work
  19. --                     with ANY standard Ada 83 or Ada 95 compiler.  On some
  20. --                     systems, VANILLA.ADA may require you to strike ENTER
  21. --                     after each response.
  22. --
  23. -- See the PRINT.ME file for more information on installing ADA-TUTR on other
  24. -- computers.
  25. --
  26. --
  27. -- Before Running ADA-TUTR on a PC:
  28. --
  29. -- ADA-TUTR uses ANSI escape sequences for highlighting, cursor positioning,
  30. -- reverse video, etc.  Before ADA-TUTR will work correctly on a PC, you must
  31. -- install the device driver ANSI.SYS, which came with your copy of DOS.  To
  32. -- install ANSI.SYS, do the following:
  33. --
  34. -- 1.  If there's a file CONFIG.SYS in the root directory of the disk from
  35. --     which you boot, type it and look for a line saying "DEVICE=ANSI.SYS"
  36. --     (without the quotes), in either upper or lower case.  If that line isn't
  37. --     present, add it to CONFIG.SYS anywhere in the file, using an ordinary
  38. --     text editor or word processor in the non-document mode.  If there's no
  39. --     CONFIG.SYS file, create one containing the single line "DEVICE=ANSI.SYS"
  40. --     (without the quotes).
  41. --
  42. -- 2.  If there's no file ANSI.SYS in your root directory, copy ANSI.SYS from
  43. --     your DOS distribution diskette or DOS subdirectory to the root directory
  44. --     of the disk from which you boot.
  45. --
  46. -- 3.  Reboot the computer.  ADA-TUTR should then work correctly.
  47. --
  48.  
  49. -- Introduction:
  50. --
  51. -- ADA-TUTR provides interactive instruction in the Ada programming language,
  52. -- allowing you to learn at your own pace.  On a PC, access to an Ada compiler
  53. -- is helpful, but not required.  You can exit this program at any time by
  54. -- striking X, and later resume the session exactly where you left off.  If you
  55. -- have a color monitor, you can set the foreground, background, and border
  56. -- colors at any time by typing S.
  57. --
  58. -- ADA-TUTR presents a screenful of information at a time.  Screens are read
  59. -- in 64-byte blocks from the random access file ADA_TUTR.DAT, using Direct_IO.
  60. -- For most screens, ADA-TUTR waits for you to strike one character to
  61. -- determine which screen to show next.  Screens are numbered starting with
  62. -- 101; each screen has a three-digit number.  Screens 101 through 108 have
  63. -- special uses, as follows:
  64. --
  65. -- 101 - This screen is presented when you complete the Ada course.  It
  66. --       contains a congratulatory message.  After this screen is shown,
  67. --       control returns directly to the operating system; the program doesn't
  68. --       wait for you to strike a character.
  69. -- 102 - This screen is presented when you exit ADA-TUTR before completing the
  70. --       course.  After this screen is shown, control returns directly to the
  71. --       operating system; the program doesn't wait for you to strike a
  72. --       character.
  73. -- 103 - This screen is shown whenever you strike X.  It displays the number of
  74. --       the last screen shown and the approximate percentage through the
  75. --       course.  It then asks if you want to exit the program.  If you strike
  76. --       Y, screen 102 is shown and control returns to the operating system.
  77. --       If you type N, screen 108 is shown to provide a menu of further
  78. --       choices.  From screen 103, you can also strike M to see the main menu
  79. --       (screen 106).
  80. -- 104 - This is the opening screen.  It asks if you've used ADA-TUTR before.
  81. --       If you strike N, a welcome screen is presented and the course begins.
  82. --       If you strike Y, screen 107 is shown.
  83. -- 105 - This screen allows you to type the number of the next screen you want
  84. --       to see.  For this screen, instead of striking one character, you type
  85. --       a three-digit number and presses ENTER.  Any number from 104 through
  86. --       the largest screen number is accepted.
  87. -- 106 - This screen contains the main menu of topics covered in ADA-TUTR.
  88. --       When you select a main topic, an appropriate sub-menu is shown.
  89. -- 107 - This screen is shown when you say that you've used ADA-TUTR before.
  90. --       It says "Welcome back!" and provides a menu that lets you resume where
  91. --       you left off, go back to the last question or Outside Assignment, go
  92. --       to the main menu (screen 106), or go to any specified screen number
  93. --       (via screen 105).
  94. -- 108 - This screen is shown when you answer N to screen 103.  It provides a
  95. --       menu similar to screen 107, except that the first choice takes you
  96. --       back to the screen shown before you saw 103.  For example, if you
  97. --       strike X while viewing screen 300, you'll see screen 103.  If you then
  98. --       answer N, you'll see screen 108.  From 108 the first menu selection
  99. --       takes you back to 300.
  100. --
  101.  
  102. -- Format of the Data File:
  103. --
  104. -- ADA-TUTR.DAT is a random access file of 64-byte blocks.  The format of this
  105. -- file changed considerably with version 2.00 of ADA-TUTR.  It's now much more
  106. -- compact, and, although it's still a data file, it now contains only the 95
  107. -- printable ASCII characters.
  108. --
  109. -- The first block of ADA_TUTR.DAT is referred to as block 1, and the first 35
  110. -- blocks together are called the index.  Bytes 2 through 4 of block 1 contain,
  111. -- in ASCII, the number of the welcome screen that's shown when you say that
  112. -- you haven't used ADA-TUTR before.  Bytes 6 through 8 of block 1 contain the
  113. -- number of the highest screen in the course.  (Bytes 1 and 5 of block 1
  114. -- contain spaces.)
  115. --
  116. -- Bytes 9 of block 1 through the end of block 31 contain four bytes of
  117. -- information for each of the possible screens 101 through 658.  For example,
  118. -- information for screen 101 is stored in bytes 9 through 12 of block 1, the
  119. -- next four bytes are for screen 102, etc.  For screens that don't exist, all
  120. -- four bytes contain spaces.
  121. --
  122. -- The first of the four bytes is A if the corresponding screen introduces an
  123. -- Outside Assignment, Q if the screen asks a question, or a space otherwise.
  124. -- The next two bytes give the number of the block where data for the screen
  125. -- begins, in base 95!  A space represents 0, ! represents 1, " represents 2,
  126. -- # represents 3, $ represents 4, etc., through all the printable characters
  127. -- of the ASCII set.  A tilde (~) represents 94.
  128. --
  129. -- The last of the four bytes gives the position, 1 through 64, within the
  130. -- block where the data for this screen starts.  Again, ! represents 1,
  131. -- " represents 2, # represents 3, etc.
  132. --
  133. -- Data for the screens are stored starting in position 1 of block 36.  In the
  134. -- screen data, the following characters have special meaning:
  135. --
  136. --           %  turns on high intensity.
  137. --           @  displays the number of spaces indicated by the next
  138. --                 character (# represents 3, $ represents 4, etc.)
  139. --           \  turns on reverse video and leaves one space.
  140. --           ^  turns on high intensity and leaves one space.
  141. --           `  restores normal video.
  142. --           {  causes CR-LF.
  143. --           }  moves cursor to row 24, column 1, for a prompt.
  144. --           ~  restores normal video and leaves one space.
  145. --
  146. -- These characters have special meaning in screen 103 only:
  147. --
  148. --           #  shows approximate percentage through the course.
  149. --           $  shows the number of the screen seen before 103.
  150. --
  151. -- Immediately after }, b represents "Please type a space to go on, or B to go
  152. -- back." and q represents "Please type a space to go on, or B or Q to go back
  153. -- to the question."
  154. --
  155.  
  156. --
  157. -- The data for each screen is followed by the "control information" for that
  158. -- screen, in square brackets.  The control information is a list of characters
  159. -- that you might strike after seeing this screen.  Each character is followed
  160. -- by the three-digit number of the next screen to be shown when that character
  161. -- is struck.  For example, Y107N122 is the control information for screen 104.
  162. -- This means that if you strike Y, screen 107 will be shown next, and if you
  163. -- strikes N, screen 122 will be shown.  Striking any other character will
  164. -- simply cause a beep (except that X can always be typed to exit the program,
  165. -- S can always be typed to set colors, and CR will be ignored).  If the
  166. -- control information is simply #, you are prompted to type the next screen
  167. -- number.  This feature is used in screen 105.
  168. --
  169. -- A "screen number" of 098 following a character means "go back to the last
  170. -- Outside Assignment," and 099 means "go back to the last question."  These
  171. -- special numbers are used in screens 107 and 108.  Number 100 means "go back
  172. -- to the previous screen seen."
  173. --
  174. -- ADA-TUTR opens the Data File in In_File mode for read-only access.
  175. --
  176. --
  177. --
  178. -- Format of the User File:
  179. --
  180. -- The User File ADA_TUTR.USR initially doesn't exist.  It's created the first
  181. -- time ADA-TUTR is run.
  182. --
  183. -- ADA_TUTR.USR is a random access file containing one 64-byte block.  Bytes 2
  184. -- through 4 contain, in ASCII, the number of the last screen read the last
  185. -- time you ran ADA-TUTR.  Byte 6 contains a digit for the foreground color you
  186. -- select, byte 8 contains a digit for the background color, and byte 10
  187. -- contains a digit for the border color.  All other bytes contain spaces.  The
  188. -- ASCII characters '0' through '7' represent black, red, green, yellow, blue,
  189. -- magenta, cyan, and white, in that order.  Note that not all color PCs have a
  190. -- separate border color.  ADA_TUTR.USR is a random access file so that it can
  191. -- be easily updated by Ada.  It contains 64 bytes so that it can be accessed
  192. -- with the same package, namely Random_IO, that accesses the Data File.
  193. --
  194. -- If the User File exists, ADA-TUTR opens it in Inout_File mode for read/write
  195. -- access.  If it doesn't exist, ADA-TUTR creates it.
  196. --
  197.  
  198. with Custom_IO, Direct_IO; use Custom_IO;
  199. procedure Ada_Tutr is
  200.    subtype Block_Subtype is String(1 .. 64);
  201.    package Random_IO is new Direct_IO(Block_Subtype); use Random_IO;
  202.    IxSize      : constant := 35;              -- Number of blocks in the index.
  203.    Data_File   : File_Type;            -- The file from which screens are read.
  204.    User_File   : File_Type;          -- Remembers last screen seen, and colors.
  205.    Block       : Block_Subtype;                -- Buffer for random-access I/O.
  206.    Vpos        : Integer;                       -- Number of the current block.
  207.    Hpos        : Integer;             -- Current position within current block.
  208.    SN, Old_SN  : Integer := 104;        -- Screen num. and previous screen num.
  209.    Quitting_SN : Integer := 104;           -- Screen number where you left off.
  210.    Highest_SN  : Integer;               -- Highest screen number in the course.
  211.    Welcome_SN  : Integer;           -- Number of the screen shown to new users.
  212.    Indx        : String(1 .. 64*IxSize);           -- Index from the Data File.
  213.    Files_OK    : Boolean := False;        -- True when files open successfully.
  214.    Legal_Note  : constant String := " Copyright 1988-96 John J. Herro ";
  215.                        -- Legal_Note isn't used by the program, but it causes
  216.                        -- most compilers to place this string in the .EXE file.
  217.    procedure Open_Data_File is separate;
  218.    procedure Open_User_File is separate;
  219.    procedure Show_Current_Screen is separate;
  220.    procedure Get_Next_Screen_Number is separate;
  221. begin
  222.    Open_Data_File;
  223.    Open_User_File;
  224.    if Files_OK then
  225.       Set_Border_Color(To => Border_Color);              -- Set default colors.
  226.       Put(Normal_Colors);
  227.       while SN > 0 loop          -- "Screen number" of 0 means end the program.
  228.          Put(Clear_Scrn);                                  -- Clear the screen.
  229.          Show_Current_Screen;
  230.          Get_Next_Screen_Number;
  231.       end loop;
  232.       Block := (others => ' ');       -- Write user-specific data to user file.
  233.       Block(1 .. 4) := Integer'Image(Quitting_SN);
  234.       Block(6)  := Fore_Color_Digit;
  235.       Block(8)  := Back_Color_Digit;
  236.       Block(10) := Character'Val(Color'Pos(Border_Color) + 48);
  237.       Write(User_File, Item => Block, To => 1);
  238.       Close(Data_File);
  239.       Close(User_File);
  240.    end if;
  241. end Ada_Tutr;
  242.  
  243. separate (Ada_Tutr)
  244. procedure Open_Data_File is
  245.    Data_File_Name : constant String := "ADA_TUTR.DAT";
  246. begin
  247.    Open(Data_File, Mode => In_File, Name => Data_File_Name);
  248.    for I in 1 .. IxSize loop             -- Read index from start of Data File.
  249.       Read(Data_File, Item => Block, From => Count(I));
  250.       Indx(64*I - 63 .. 64*I) := Block;
  251.    end loop;
  252.    Welcome_SN := Integer'Value(Indx(2 .. 4));
  253.    Highest_SN := Integer'Value(Indx(6 .. 8));
  254.    Files_OK := True;
  255. exception
  256.    when Name_Error =>
  257.       Put("I'm sorry.  The file " & DATA_FILE_NAME);
  258.       Put_Line(" seems to be missing.");
  259.    when others =>
  260.       Put("I'm sorry.  The file " & DATA_FILE_NAME);
  261.       Put_Line(" seems to have the wrong form.");
  262. end Open_Data_File;
  263.  
  264.  
  265.  
  266. separate (Ada_Tutr)
  267. procedure Open_User_File is
  268.    User_File_Name : constant String := "ADA_TUTR.USR";
  269. begin
  270.    Open(User_File, Mode => Inout_File, Name => User_File_Name);
  271.    Read(User_File, Item => Block, From => 1);
  272.    Quitting_SN      := Integer'Value(Block(1 .. 4));
  273.    Old_SN           := Quitting_SN;
  274.    Foregrnd_Color   := Color'Val(Integer'Value(Block(5 .. 6)));
  275.    Backgrnd_Color   := Color'Val(Integer'Value(Block(7 .. 8)));
  276.    Border_Color     := Color'Val(Integer'Value(Block(9 .. 10)));
  277.    Fore_Color_Digit := Block(6);
  278.    Back_Color_Digit := Block(8);
  279.    Normal_Colors(6) := Fore_Color_Digit;
  280.    Normal_Colors(9) := Back_Color_Digit;
  281. exception
  282.    when Name_Error =>
  283.       begin
  284.          Create(User_File, Mode => Inout_File, Name => User_File_Name);
  285.       exception
  286.          when others =>
  287.             Put("I'm sorry.  I couldn't find or create ");
  288.             Put_Line(User_File_Name);
  289.             Files_OK := False;
  290.       end;
  291.    when others =>
  292.       Put_Line("I'm sorry.  The file " & USER_FILE_NAME & " seems to have");
  293.       Put_Line("the wrong form or contain bad data.");
  294.       Put_Line("You might want to delete the file and try again.");
  295.       Put_Line("(Default values will be used.)");
  296.       Files_OK := False;
  297. end Open_User_File;
  298.  
  299. separate (Ada_Tutr)
  300. procedure Show_Current_Screen is
  301.    Half_Diff : Integer := (Highest_SN - Welcome_SN) / 2;
  302.    Percent   : Integer := (50 * (Old_SN - Welcome_SN)) / Half_Diff;
  303.                           -- Percentage of the course completed.  Using 50 and
  304.                           -- Half_Diff guarantees that the numerator < 2 ** 15.
  305.    Expanding : Boolean := False;        -- True when expanding multiple spaces.
  306.    Literal   : Boolean := False;       -- True to display next character as is.
  307.    Prompting : Boolean := False;       -- True for first character in a prompt.
  308.    Space     : constant String(1 .. 80) := (others => ' ');
  309.    procedure Process_Char is separate;
  310. begin
  311.    Vpos := 95*(Character'Pos(Indx(SN*4 - 394)) - 32) +        -- Point to start
  312.                Character'Pos(Indx(SN*4 - 393)) - 32;          -- of current
  313.    Hpos := Character'Pos(Indx(SN*4 - 392)) - 32;              -- screen.
  314.    Read(Data_File, Item => Block, From => Count(Vpos));
  315.    if Percent < 0 then                      -- Make sure Percent is reasonable.
  316.       Percent := 0;
  317.    elsif Percent > 99 then
  318.       Percent := 99;
  319.    end if;
  320.    while Block(Hpos) /= '[' or Expanding or Literal loop -- [ starts ctrl info.
  321.       if Expanding then
  322.          if Block(Hpos) = '!' then
  323.             Literal := True;
  324.          else
  325.             Put(Space(1 .. Character'Pos(Block(Hpos)) - 32));
  326.          end if;
  327.          Expanding := False;
  328.       elsif Literal then
  329.          Put(Block(Hpos));
  330.          Literal := False;
  331.       elsif Prompting then
  332.          case Block(Hpos) is
  333.             when 'b' => Put("Please type a space to go on, or B to go back.");
  334.             when 'q' => Put("Please type a space to go on, or B or Q to go ");
  335.                         Put("back to the question.");
  336.             when others => Process_Char;
  337.          end case;
  338.          Prompting := False;
  339.       else
  340.          Process_Char;
  341.       end if;
  342.       Hpos := Hpos + 1;
  343.       if Hpos > Block'Length then
  344.          Vpos := Vpos + 1;
  345.          Hpos := 1;
  346.          Read(Data_file, Item => Block, From => Count(Vpos));
  347.       end if;
  348.    end loop;
  349. end Show_Current_Screen;
  350.  
  351. separate (Ada_Tutr.Show_Current_Screen)
  352. procedure Process_Char is
  353. begin
  354.    case Block(Hpos) is
  355.       when '{'    => New_Line;                           -- { = CR-LF.
  356.       when '@'    => Expanding := True;                  -- @ = several spaces.
  357.       when '^'    => Put(ASCII.ESC & "[1m ");            -- ^ = bright + space.
  358.       when '~'    => Put(Normal_Colors & ' ');           -- ~ = normal + space.
  359.       when '%'    => Put(ASCII.ESC & "[1m");             -- % = bright.
  360.       when '`'    => Put(Normal_Colors);                 -- ` = normal.
  361.       when '}'    => Put(ASCII.ESC & "[24;1H");          -- } = go to line 24.
  362.                      Prompting := True;
  363.       when '\'    => Put(ASCII.ESC & "[7m ");            -- \ = rev. vid. + sp.
  364.       when '$'    => if SN = 103 then                    -- $ = screen #.
  365.                         Put(Integer'Image(Old_SN));
  366.                      else
  367.                         Put('$');
  368.                      end if;
  369.       when '#'    => if SN = 103 then                    -- # = % completed.
  370.                         Put(Integer'Image(Percent));
  371.                      else
  372.                         Put('#');
  373.                      end if;
  374.       when others => Put(Block(Hpos));
  375.    end case;
  376. end Process_Char;
  377.  
  378. separate (Ada_Tutr)
  379. procedure Get_Next_Screen_Number is
  380.    Ctrl_Info : Block_Subtype;          -- Control info. for the current screen.
  381.    Place     : Integer := 1;              -- Current position within Ctrl_Info.
  382.    Input     : String(1 .. 4);                  -- Screen number that you type.
  383.    Len       : Integer;                            -- Length of typed response.
  384.    Valid     : Boolean;                   -- True when typed response is valid.
  385.    procedure Set_Colors is separate;
  386.    procedure Input_One_Keystroke is separate;
  387. begin
  388.    while Block(Hpos) /= ']' loop    -- Read control information from Data File.
  389.       Hpos := Hpos + 1;
  390.       if Hpos > Block'Length then
  391.          Vpos := Vpos + 1;
  392.          Hpos := 1;
  393.          Read(Data_File, Item => Block, From => Count(Vpos));
  394.       end if;
  395.       Ctrl_Info(Place) := Block(Hpos);
  396.       Place := Place + 1;
  397.    end loop;
  398.    if SN = 103 then                    -- Screen 103 means you typed X to exit.
  399.       Quitting_SN := Old_SN;
  400.    elsif SN >= Welcome_SN then              -- Save SN so you can return to it.
  401.       Old_SN := SN;
  402.    end if;
  403.    if SN < 103 then                          -- Set SN to # of the next screen.
  404.       SN := 0;      -- Set signal to end the program after screens 101 and 102.
  405.    elsif Ctrl_Info(1) = '#' then            -- You type the next screen number.
  406.       Valid := False;
  407.       while not Valid loop              -- Keep trying until response is valid.
  408.          Put("# ");                                -- Prompt for screen number.
  409.          Input := "    ";  Get_Line(Input, Len);        -- Input screen number.
  410.          if Input(1) = 'x' or Input(1) = 'X' or Input(1) = ASCII.ETX then
  411.             SN := 103;                        -- Show screen 103 if you type X.
  412.             Valid := True;                            -- X is a valid response.
  413.          elsif Input(1) = 's' or Input(1) = 'S' then
  414.             Set_Colors;                            -- Set colors if you type S.
  415.             Valid := True;                            -- S is a valid response.
  416.          else
  417.             begin                                    -- Convert ASCII input to
  418.                SN := Integer'Value(Input);           -- integer.  If in range,
  419.                Valid := SN in 104 .. Highest_SN;     -- set Valid to True.  If
  420.             exception                                -- it can't be converted
  421.                when others => null;                  -- (e.g., illegal char.),
  422.             end;                                     -- or it's out of range,
  423.          end if;                                     -- leave Valid = False so
  424.          if not Valid and Len > 0 then               -- you can try again.
  425.             Put_Line("Incorrect number.  Please try again.");
  426.          end if;
  427.       end loop;
  428.    else
  429.       Input_One_Keystroke;
  430.    end if;
  431. end Get_Next_Screen_Number;
  432.  
  433. separate (Ada_Tutr.Get_Next_Screen_Number)
  434. procedure Set_Colors is
  435.    Bright    : constant String := ASCII.ESC & "[1m";  -- Causes high intensity.
  436.    Keystroke : Character := 'f';             -- Single character that you type.
  437.    Space     : constant String(1 .. 23) := (others => ' ');
  438. begin
  439.    while Keystroke = 'f' or Keystroke = 'b' or Keystroke = 'r' or
  440.          Keystroke = 'F' or Keystroke = 'B' or Keystroke = 'R' loop
  441.       Put(Clear_Scrn);                                     -- Clear the screen.
  442.       New_Line;
  443.       Put(Space & "The " & Bright & "foreground" & Normal_Colors);
  444.       Put_Line(" color is now " & Color'Image(Foregrnd_Color) & '.');
  445.       Put(Space & "The " & Bright & "background" & Normal_Colors);
  446.       Put_Line(" color is now " & Color'Image(Backgrnd_Color) & '.');
  447.       Put(Space & "The " & Bright & "  border  " & Normal_Colors);
  448.       Put_Line(" color is now " & Color'Image(Border_Color) & '.');
  449.       New_Line;
  450.       Put_Line(Space & " Note:  Some color PCs don't have");
  451.       Put_Line(Space & "     separate border colors.");
  452.       New_Line;
  453.       Put_Line(Space & "             Strike:");
  454.       Put_Line(Space & "F to change the foreground color,");
  455.       Put_Line(Space & "B to change the background color,");
  456.       Put_Line(Space & "R to change the   border   color.");
  457.       New_Line;
  458.       Put_Line(Space & "Strike any other key to continue.");
  459.       Get(Keystroke);                       -- Get one character from keyboard.
  460.       if Keystroke = 'f' or Keystroke = 'F' then
  461.          Foregrnd_Color := Color'Val((Color'Pos(Foregrnd_Color) + 1) mod 8);
  462.          if Foregrnd_Color = Backgrnd_Color then
  463.             Foregrnd_Color := Color'Val((Color'Pos(Foregrnd_Color) + 1) mod 8);
  464.          end if;
  465.       elsif Keystroke = 'b' or Keystroke = 'B' then
  466.          Backgrnd_Color := Color'Val((Color'Pos(Backgrnd_Color) + 1) mod 8);
  467.          if Foregrnd_Color = Backgrnd_Color then
  468.             Backgrnd_Color := Color'Val((Color'Pos(Backgrnd_Color) + 1) mod 8);
  469.          end if;
  470.       elsif Keystroke = 'r' or Keystroke = 'R' then
  471.          Border_Color := Color'Val((Color'Pos(Border_Color) + 1) mod 8);
  472.       end if;
  473.       Fore_Color_Digit := Character'Val(48 + Color'Pos(Foregrnd_Color));
  474.       Back_Color_Digit := Character'Val(48 + Color'Pos(Backgrnd_Color));
  475.       Normal_Colors(6) := Fore_Color_Digit;
  476.       Normal_Colors(9) := Back_Color_Digit;
  477.       Put(Normal_Colors);
  478.       Set_Border_Color(To => Border_Color);
  479.    end loop;
  480. end Set_Colors;
  481.  
  482. separate (Ada_Tutr.Get_Next_Screen_Number)
  483. procedure Input_One_Keystroke is
  484.    Keystroke : Character;                    -- Single character that you type.
  485.    Valid     : Boolean := False;          -- True when typed response is valid.
  486.    Where     : Integer;              -- Location of control block in Data File.
  487.    Search    : Character;    -- 'A' = last Outside Assignment; 'Q' = last Ques.
  488. begin
  489.    Put("  >");                                     -- Prompt for one character.
  490.    while not Valid loop                 -- Keep trying until response is valid.
  491.       Get(Keystroke);                       -- Get one character from keyboard.
  492.       if Keystroke in 'a' .. 'z' then          -- Force upper case to simplify.
  493.          Keystroke := Character'Val(Character'Pos(Keystroke) - 32);
  494.       end if;
  495.       if Keystroke = 'X' or Keystroke = ASCII.ETX then
  496.          SN := 103;                           -- Show screen 103 if you type X.
  497.          Valid := True;                               -- X is a valid response.
  498.       elsif Keystroke = 'S' then
  499.          Set_Colors;                               -- Set colors if you type S.
  500.          Valid := True;                               -- S is a valid response.
  501.       end if;
  502.       Place := 1;           -- Search list of valid characters for this screen.
  503.       Valid := Valid;             -- This statement works around a minor bug in
  504.                                   -- ver. 1.0 of the Meridian IFORM optimizer.
  505.       while not Valid and Ctrl_Info(Place) /= ']' loop      -- ] ends the list.
  506.          if Keystroke = Ctrl_Info(Place) then
  507.                   -- Typed char. found in list; get screen # from control info.
  508.             SN := Integer'Value(Ctrl_Info(Place + 1 .. Place + 3));
  509.             Valid := True;   -- Characters in the list are all valid responses.
  510.          end if;
  511.          Place := Place + 4;    -- A 3-digit number follows each char. in list.
  512.       end loop;
  513.       if not Valid and Keystroke /= ASCII.CR then        -- Beep if response is
  514.          Put(ASCII.BEL);                                 -- not valid, but
  515.       end if;                                            -- ignore CRs quietly.
  516.    end loop;
  517.    if SN = 98 then                       -- Go back to last Outside Assignment.
  518.       Search := 'A';
  519.    elsif SN = 99 then                              -- Go back to last question.
  520.       Search := 'Q';
  521.    elsif SN = 100 then                      -- Go back to the last screen seen.
  522.       SN := Quitting_SN;
  523.    end if;
  524.    if SN = 98 or SN = 99 then
  525.       SN := Old_SN;
  526.       while SN > Welcome_SN and Indx(SN*4 - 395) /= Search loop
  527.          SN := SN - 1;
  528.       end loop;
  529.    end if;
  530. end Input_One_Keystroke;
  531.